home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Directorty Opus 5 - Magellan 2
/
Opus 5 - Magellan 2.iso
/
Extras
/
D51_NUSource
/
Source
/
Routines
/
System.s
< prev
Wrap
Text File
|
1996-01-06
|
15KB
|
395 lines
*=- INFO -=****************************************************************************
* System Subroutines. (File access, Communication, etc) *
* Unless otherwise stated, all routines are by Leo 'Nudel' Davidson *
*=- Notes -===========================================================================*
* o Error should always be called using the Beq_ErrorX macros in Constants.i *
*=- To Do -===========================================================================*
* o DeleteNudelPort Should ensure that all msgs have been replied before deletion. *
* (Currently, all programs using *NudelPort should never get non-reply messages). *
* o Error should put up an alert when any of its sub-routines fail. *
*=- History -=========================================================================*
* o Version 2.00 *
* Ancient history deleted. *
***************************************************************************************
***************************************************************************************
* System Subroutines *
***************************************************************************************
;;; "Error" is not optional.
;SYS_READARG ; ReadArgs() routine.
;SYS_FREEARG ; FreeArgs() routine.
;SYS_CLIRITE ; Write text using CLI_Hdl(a5) as output handle.
;SYS_CHKCRTC ; Check for ^C-Break and abort program if sent.
;SYS_PORTS ; CreateMsgPort(), DeleteMsgPort() routines.
;Include Asm:Source/Routines/System.s
;-------------------------------------------------------------------------------------;
;- STD_F_1 ---------------------------------------------------------- Standard Flags -;
;-------------------------------------------------------------------------------------;
SF1_ReadArgs Equ 0 RDArgs Structure requires FreeArgs()
SF1_OpnLibErr Equ 1 If set, one or more libs couldn't be openned.
SF1_ErrorReq Equ 2 If set, next error routine output w/ a req.
; (Reset to default after every error call).
; NOTE: This _may_ be used by other functions.
IFD DOpus5_Error Make SURE it causes an error if used wrongly.
SF1_ErrorDop Equ 3 If set, next error will output via "dopus request"
ENDC
SF1_OpenIFF Equ 4 If set, NudelIFFHandle(a5) requires CLOSE.
SF1_NewListers Equ 5 Get(Source|Dest)Handle allowed to create new listers?
IFD SYS_PORTS
*= Create NudelMsgPort (NORMAL) =**************************************= 11-Aug-1995 =*
* Inputs: None. *
* Outputs: NudelPort(a5) - Ptr to our MsgPort *
***************************************************************************************
CreateNudelPort
N_CallExec CreateMsgPort -.
Move.l d0,NudelPort(a5) |- Create our msgport.
Beq_ErrorE ErrAct_CreateMsgPort(pc),#0 -'
RTS
ErrAct_CreateMsgPort
Dc.b "Could not create MsgPort",0
Even
*= Delete NudelMsgPort (NORMAL) =**************************************= 11-Aug-1995 =*
* Inputs: NudelPort(a5) - Ptr to our MsgPort *
* Outputs: NudelPort(a5) - Null. *
*=====================================================================================*
* Notes: Ensures that all msgs have been GetMsg()'d before DeleteMsgPort. *
***************************************************************************************
DeleteNudelPort
Tst.l NudelPort(a5) -._ If no MsgPort to free,
Beq.s DMsgSkp -' skip this routine.
N_CallExec Forbid Forbid Multitasking so no new messages sent.
DNP_WP_Loop
Move.l NudelPort(a5),a0 -._ Get first waiting
N_CallExec GetMsg -' message sent to us.
Tst.l d0 -._ If there are none left,
Beq.s DNP_WP_Skip -' It's safe to close down.
Bsr_ErrorW ErrAct_PendingMessages(pc),#0
Bra.s DNP_WP_Loop
DNP_WP_Skip
Move.l NudelPort(a5),a0 -._ Delete
N_CallExec DeleteMsgPort -' the port.
Move.l #0,NudelPort(a5) Null Pointer to stop re-free.
N_CallExec Permit Permit Multitasking again.
DMsgSkp
RTS
ErrAct_PendingMessages
Dc.b "Messages pending at port closure - please report to Leo",0
Even
ENDC
IFD SYS_READARG
*= READ ARGS (NORMAL) =**************************************= 24-Jul-1995 =*
* RDA_Template(pc) = Template * RDA_Array(a5) = Array of LongWords *
* RDA_Rtn(a5) = (Pointer to returned RDArgs structure) *
*===========================================================================*
* RDA_Array(a5) should be initialized to default values before calling. *
*****************************************************************************
RArgNor BTst #SF1_ReadArgs,STD_F_1(a5) -._ Generate an Error if
Bne Internal -' previous Read & no Free.
Lea RDA_Template(pc),a0 Template for ReadArgs()
Move.l a0,d1
Lea RDA_Array(a5),a0 Array space for ReadArgs()
Move.l a0,d2
Moveq #0,d3 Use default options for ReadArgs()
N_CallDOS ReadArgs
Move.l d0,RDA_Rtn(a5) Store returned pointer to structure.
Beq_ErrorE ErrAct_ReadArgs(pc),#0 Fatal Error, No Filename.
BSet #SF1_ReadArgs,STD_F_1(a5) ReadArgs done, need freeing.
FArgNDn RTS
ErrAct_ReadArgs
Dc.b "Could not parse command-line",0
Even
ENDC
IFD SYS_FREEARG
*= FREE ARGS (NORMAL) =**************************************= 24-Jul-1995 =*
* RDA_Rtn(a5) = Pointer to RDArgs structure returned by ReadArgs() *
*****************************************************************************
FArgNor BClr #SF1_ReadArgs,STD_F_1(a5)
Beq.s FArgNDn If no FreeArgs() needed, skip.
Move.l RDA_Rtn(a5),d1
N_JumpDOS FreeArgs
;;;;;;; RTS for us.
ENDC
IFD SYS_CLIRITE
*= CLI WRITE =***************************************************************
* a0 = Start of text to be written * d3 = #Chars to be Written *
* CLI_Hdl(a5) - Handle of CLI * *
*****************************************************************************
CLIRite Move.l a0,d2
CLIRit2 Move.l CLI_Hdl(a5),d1
Lea CLIRite_NIB_FileName(pc),a0 -._ Set pseudo-filename
Move.l a0,NIB_NameAdrs+FakeNIB(a5) -' in FakeNIB.
N_CallDOS Write RTS for us.
Cmpi.l #-1,d0
Beq_ErrorE ErrAct_Write(pc),FakeNIB_Adrs(a5) Fatal error.
RTS
CLIRite_NIB_FileName
Dc.b "standard output"
EVEN
ENDC
IFD SYS_CHKCRTC
*= CHECK CTRL-C =******************************************************= 16-Aug-1995 =*
* Checks for if ^C has been pressed, and if so prints "***Break" and Exits *
* All registers preserved. (But not CCR) *
***************************************************************************************
CkCtrlC Movem.l d0-d7/a0-a6,-(SP) Preserve everything.
Moveq #0,d0 No new signals.
Move.l #SIGBREAKF_CTRL_C,d1 Clear ^C Signal
N_CallExec SetSignal Do it & OldSignals -> d0
BTst #SIGBREAKB_CTRL_C,d0 Was ^C Set?
Bne.s YoBreak YES=Exit
Movem.l (SP)+,d0-d7/a0-a6 Restore everything.
RTS
YoBreak Lea BreakMs(pc),a0 -.
Move.l #BreakML,d3 |- Write "***Break"
Bsr.s CLIRite -'
Bra Finish and then Exit the Proggy.
BreakMs Dc.b 10,155,"0m***Break: "
PROGNAM
Dc.b 10
BreakML Equ *-BreakMs
Even
ENDC
*= ERROR =*************************************************************= 16-Aug-1995 =*
* ErrorE for FATAL errors, and ErrorW for non-fatal (will return to caller). *
* This routine should ALWAYS be called using the Beq_ErrorX macros in Constants.i *
*=====================================================================================*
* Inputs: Buffer1(a5) - Buffer to write message into (#Buffer1Len bytes long) *
* Active_NIB(a5)/NIB_NameAdrs - Pointer to name of file (etc.) *
* CAction(a5) - Pointer to null-term "Could not lock file" type message. *
* Outputs: DosRtnC(a5) - #ERROR, #WARN, or left-alone (NOTICE). *
*=====================================================================================*
* If Active_NIB(a5) or NIB_NameAdrs are Null, filename is not output. *
* If CAction(a5) is null, no action is output (will look stupid) *
* If IoErr() returns zero, no reason output. *
***************************************************************************************
ErrorE_Internal
Moveq #0,d1 SetIoErr(#0)
N_CallDOS SetIoErr No Error.
ErrorE Cmpi.l #RETURN_ERROR,DosRtnC(a5) -.
Bge.s ErrorESkp |- "ERROR" return code, unless a worse
Move.l #RETURN_ERROR,DosRtnC(a5) -' one has already been set.
ErrorESkp
Lea ErrHead_Error(pc),a0 Fatal-Error message.
Bsr.s Error_Main_Subroutine As Error-Warn.
Bra Finish Finish the program.
;-------------------------------------------------------------------------------------;
ErrorN Moveq #0,d1 SetIoErr(#0)
N_CallDOS SetIoErr No Error.
Lea ErrHead_Notice(pc),a0 "Note" message.
Bra.s Error_Main_Subroutine
;;;;;;; RTS for us.
;-------------------------------------------------------------------------------------;
ErrorW Cmpi.l #RETURN_WARN,DosRtnC(a5) -.
Bge.s ErrorWSkp |- "WARN" return code, unless a worse
Move.l #RETURN_WARN,DosRtnC(a5) -' one has already been set.
ErrorWSkp
Lea ErrHead_Warn(pc),a0 Warning-Error message.
;;;;;;; Bra.s Error_Main_Subroutine
;;;;;;; RTS for us.
;-------------------------------------------------------------------------------------;
Error_Main_Subroutine
Move.l a0,RDF_1_Long(a5) "Error"/"Warn"/"Notice" header is first %s
Move.l CAction(a5),RDF_2_Long(a5) Action is the second %s
Tst.l Active_NIB(a5) -.
Bne.s EW_GotNIB_Skp |- If no active NIB, no filename.
Move.l #0,RDF_3_Long(a5) -'
Bra.s EW_NoNIB_Skp
EW_GotNIB_Skp
Move.l Active_NIB(a5),a0 -._ Adrs of filename from NIB.
Move.l NIB_NameAdrs(a0),RDF_3_Long(a5) -' If null, no string output.
EW_NoNIB_Skp
Move.l #0,Active_NIB(a5) No active NIB.
Moveq #0,d1 SetIoErr(#0) so no error in the future.
N_CallDOS SetIoErr Get number representing the error.
Move.l d0,d1 Error code to d1 for Fault()
Lea ErrReason_Header(pc),a0 -._ Header to d2
Move.l a0,d2 -' for Failt()
Lea Buffer1(a5),a0 -._ Buffer to build message in.
Move.l a0,d3 -' To d3 for Fault()
SF (a0) Ensure it's null-terminated to start with.
;;;;;;; So that it can be used even if Fault() doesn't write into it.
Move.l #Buffer1Len,d4 Size of the buffer to d4 for Fault()
N_CallDOS Fault Put error message into the buffer.
;;;;;;; Tst.l d0 Ignore result, Buffer1 can be used anyway.
Lea Buffer1(a5),a0 -._ Adrs of reason is the
Move.l a0,RDF_4_Long(a5) -' fourth %s for RawDoFmt()
;-------------------------------------------------------------------------------------;
Lea RDF_Error_Input(pc),a0 Input string.
Lea RDF_Array(a5),a1 DataArray
Lea Buffer2(a5),a3 -._ Output
Move.l a3,RDF_Adrs(a5) -' Buffer
Move.l #Buffer2Len,RDF_Size(a5) Size of output buffer.
Bsr NudelRawDoFmt Create the full error message.
;-------------------------------------------------------------------------------------;
; Error string is built, not output it in whatever way... ;
;-------------------------------------------------------------------------------------;
IFD DOpus5_Error If DOpus5 error messages are allowed, check.
BClr #SF1_ErrorDop,STD_F_1(a5)
Bne.s ErrDopus5
ENDC
IFND No_Requesters If No_Requesters, go straight to Shell.
;;;;;;; (Excludes the ErrReq routine as well)
IFD Reqs_S
Tst.l Reqs_S(a5) The Reqs/S command defaults to shell.
Beq.s ErrShell
ENDC
IFD NoReq_S The NoReq/S command defauls to requester.
Tst.l NoReq_S(a5)
Bne.s ErrShell
ENDC
IFND NoReq_S
IFND Reqs_S
SetReqDefault If Reqs / NoReqS not part of RDA_Template.
Beq.s ErrShell
ENDC
ENDC
;-------------------------------------------------------------------------------------;
; Requester error output. ;
;-------------------------------------------------------------------------------------;
ErrReq
Move.l #N_EasyStruct_Len,N_ES_Length(a5) Size of structure.
Move.l #0,N_ES_Flags(a5) No flags.
Lea ErrReq_Title(pc),a0 -.
Move.l a0,N_ES_Title(a5) |
Lea Buffer2(a5),a0 |_ Texts for
Move.l a0,N_ES_Body(a5) | requester.
Lea ErrReq_Gads(pc),a0 |
Move.l a0,N_ES_Gadgets(a5) -'
Lea N_EasyStruct(a5),a1 Point to EasyRequest structure.
Sub.l a0,a0 Specify default public screen.
Move.l a0,a2 No IDCMP flags.
Move.l a0,a3 No arguments.
N_JumpInt EasyRequestArgs Put up the req. NO ERROR CHECKING, on purpose.
;;;;;;; RTS for us.
ENDC
;-------------------------------------------------------------------------------------;
; Shell error output. ;
;-------------------------------------------------------------------------------------;
ErrShell
Lea ErrReq_Title(pc),a0 -.
Move.l a0,d2 |_ Write "ProgName: "
Move.l #ErrReq_Title_Len,d3 | for start of msg.
Bsr.s ErrShell_Write -'
; Must work out the length of the returned Error text.
Lea Buffer2(a5),a0
Move.l a0,d2
Bsr NullLen
Move.l d0,d3
; A return must be added. As the string is null-terminated, and we don't need
; the null, the return can be written over the null without any buffer length
; checking.
Move.l d2,a0 -.
Add.l d3,a0 |- Point to null and replace with return.
Move.b #10,(a0) -'
Addq.l #1,d3 Update length of text to output.
;;;;;;; Bra.s ErrShell_Write
;;;;;;; Bra.s for us.
;;;;;;; RTS for us.
ErrShell_Write
Move.l CLI_Hdl(a5),d1
N_CallDOS Write NO ERROR CHECKING, on purpose.
RTS
;-------------------------------------------------------------------------------------;
; Directory Opus 5 error output. ;
;-------------------------------------------------------------------------------------;
IFD DOpus5_Error
ErrDopus5
Lea Buffer2(a5),a0 -._ Error message is the
Move.l a0,RDF_1_Long(a5) -' first (and only) %s
Lea Err_Dopus_Request_Command(pc),a0 Input string.
Lea RDF_Array(a5),a1 DataArray
Lea Buffer1(a5),a3 -._ Output
Move.l a3,RDF_Adrs(a5) -' Buffer
Move.l #Buffer1Len,RDF_Size(a5) Size of output buffer.
Bsr NudelRawDoFmt Create the full error message.
Lea Dopus_Front_Command(pc),a1 -._ Bring the DOpus
Bsr FillAndSendNudelRexxMsg -' screen to the front.
Lea Buffer1(a5),a1 -._ Put up the
Bra FillAndSendNudelRexxMsg -' requester.
;;;;;;; RTS for us.
Dopus_Front_Command
Dc.b "dopus front",0
Err_Dopus_Request_Command
Dc.b 'dopus request "%s" _OK',0
ENDC
;-------------------------------------------------------------------------------------;
; Strings. ;
;-------------------------------------------------------------------------------------;
ErrReq_Title
PROGNAM
Dc.b ": "
ErrReq_Title_Len Equ *-ErrReq_Title
IFND No_Requesters
Dc.b 0 ;Null-term for ErrReq_Title
ErrReq_Gads
Dc.b "OK",0
ENDC
RDF_Error_Input
Dc.b "%s - %s%s%s",0
ErrHead_Error
Dc.b "Error",0
ErrHead_Warn
Dc.b "Warning",0
ErrHead_Notice
Dc.b "Note",0
ErrReason_Header
Dc.b 10,"Reason",0
ErrAct_Write
Dc.b "Could not write to ",0
ErrAct_AllocMem
Dc.b "Could not allocate memory for ",0
EVEN
***************************************************************************************
Internal
Bra_ErrorE_Int ErrAct_Internal(pc),#0
Buffer_Overflow
Bra_ErrorE_Int ErrAct_BufferOverflow(pc),#0
ErrAct_Internal
Dc.b "Internal error!",0
ErrAct_BufferOverflow
Dc.b "buffer overflow",0
Even